home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1995 April / Internet Tools.iso / infoserv / gopher / Unix / GopherTools / go4check.Z / go4check
Encoding:
Text File  |  1994-08-31  |  13.7 KB  |  364 lines
  1. #!/usr/local/bin/perl
  2. # go4check, v1.0
  3. #
  4. #-------------------------------------------------------------------------------
  5. # Introduction
  6. #   go4check checks gopher links, probing each connection and testing the 
  7. #   output received.  It handles most types of links, reporting if the link 
  8. #   is ok, the host serving it is down/refusing connections, or its pathname 
  9. #   has changed.  It is not 100% successful at this, especially when it 
  10. #   comes to gopher0 servers, but does indeed help you keep on top of links
  11. #   in your server(s).
  12. #
  13. #   To run, go4check requires only perl and socket.ph.  It understands
  14. #   gopher0 and gopher+ servers.
  15. #
  16. #   go4check produces a line of output on stdout for each item appearing 
  17. #   in a gopher's menu: the name of the item plus a result.  Indentation 
  18. #   serves to maintain items in context so problems can be located easily.
  19. #   As an extra benefit, go4check's output can be used as a roadmap of
  20. #   the gopher after some rather trivial editing to remove results.
  21. #
  22. #   go4check is written by George A. Theall, theall1@mail.tju.edu.  
  23. #   You may freely use and redistribute this.  I can not offer any
  24. #   support for this but am interested in your comments, suggestions,
  25. #   and problem reports.
  26. #
  27. #-------------------------------------------------------------------------------
  28. # Operation
  29. #   Before you run go4check, make sure perl and the header file socket.ph are
  30. #   available on your system. [You can generate this file by running the perl 
  31. #   utility h2ph on /usr/include/sys/socket.h, or something similar.]
  32. #
  33. #   Invoke go4check with the name of the server to check and an optional port
  34. #   number.  Other options can be used to specify a non-standard starting
  35. #   path or generate copious debugging info.  go4check will test the items
  36. #   listed in the initial menu and recurse into any menus it finds as long
  37. #   as the names of server it finds match the one specified at go4check's
  38. #   invocation. go4check does, though, skip recursion if pathnames refer 
  39. #   to ftp gateways or point back to the initial entry point.
  40. #
  41. #   Results are directed to stdout, so you probably will want to redirect
  42. #   to a file.  You might then remove instances of "...ok.", which
  43. #   indicate no problems and finally search on "...can't connect." and
  44. #   "...path changed.".  Another possible result is "...n/a.", which
  45. #   is used when go4check doesn't know how to check a particular type of
  46. #   link.
  47. #
  48. #   You may want to tune the variables that go4check uses for testing 
  49. #   items of type 2 and 7.  See below where initial values are defined.
  50. #   For items of type 2, go4check sends a invalid command, which causes
  51. #   many CSO servers to respond in a way that go4check interprets as a
  52. #   success.  As for items of type 7, I don't know of any robust way
  53. #   to test searches.  Currently, the best solution appears to be
  54. #   to search for a word that's common to whatever searches are in the
  55. #   gopher being checked.
  56. #
  57. #   go4check is slow; it probably belongs in a cron job to run at night.
  58. #
  59. #-------------------------------------------------------------------------------
  60. # History
  61. #   01-Sep-94, GAT, v1.0
  62. #      - released publically.
  63. #
  64. #   10-Aug-94, GAT, v1.0b2
  65. #      - Added $snooze_length as a way to control how long to pause after
  66. #        establishing a connection.
  67. #      - Fixed initialization of %URLs.
  68. #      - Changed format of internal URLs by removing ":" from between type
  69. #        and path info.
  70. #      - Used a configurable word to check search items.
  71. #      - Added check of CSO servers.
  72. #      - Adjusted regular expression used to check success/failure of
  73. #        a link.
  74. #      - Documented go4check's operation.
  75. #
  76. #   12-Jul-94, GAT, v1.0b1
  77. #      - Used pseudo URLs internally for storing links so they are not
  78. #        checked more than once.
  79. #      - Added support for most types of links, including telnet, binary
  80. #        files, and searches.
  81. #      - Used gopher+ protocol whenever possible to avoid retrieving 
  82. #        entire files.
  83. #
  84. #   09-Jun-94, GAT, v1.0a
  85. #      - First version of go4check. Checks only files and directories.
  86. #
  87. #-------------------------------------------------------------------------------
  88.  
  89.  
  90. # Specify where perl can find include files.
  91. push(@INC, "/usr/local/lib/perl");
  92. push(@INC, "/usr/local/lib/perl/sys");
  93.  
  94.  
  95. # Define initial values for selected variables.
  96. $default_path2 = "helo";        # for searching type 2 items
  97. $default_path7 = "cancer";        # for searching type 7 items
  98. $Indent = "  ";                # indentation at each level
  99. $snooze_length = 3;            # time to snooze after connect
  100. %URLs = ();                # array of URL's on server
  101.  
  102.  
  103. # Check for options.
  104. $DEBUG = 0;                # default to no debug
  105. if ($ARGV[0] eq '-d') {
  106.     shift;
  107.     $DEBUG = 1;
  108. }
  109.  
  110.  
  111. # Parse commandline args and provide help as needed.
  112. $inithost = shift || "";        # name of host to check
  113. $initport = shift || 70;        # port number
  114. $initpath = shift || "";        # initial directory
  115. if ($inithost eq "" || $inithost eq "-?") {
  116.     print "$0 checks links in a gopher by probing connections\n\n";
  117.     print "Usage:  $0 [-d] host [port] [\"path\"]\n";
  118.     print "        unless specified, port defaults to 70 and path to \"\".\n";
  119.     print "        -d is used for debugging.\n";
  120.     exit(9);
  121. }
  122.  
  123.  
  124. # Establish connection and check links.
  125. require 'socket.ph';
  126. chop($thishost = `hostname`);        # needed for tcpconnect
  127. &check_Links($inithost, $initport, $initpath);
  128. exit(0);
  129.  
  130.  
  131. ########################################################################
  132. #  check_Links - checks links for a given directory.                   #
  133. #                                                                      #
  134. #  Notes:                                                              #
  135. #      - Links on the same host will be followed unless they point to  #
  136. #        the root.  While this will prevent most recursion, there may  #
  137. #        be some gophers with odd setups that lead to infinite loops.  #
  138. #      - FTP links are not followed.                                   #
  139. #  Entry:                                                              #
  140. #        host = hostname                                               #
  141. #        port = port number                                            #
  142. #        path = selector string                                        #
  143. #  Exit:                                                               #
  144. #        New links are appended to @URLs.                              #
  145. ########################################################################
  146. sub check_Links {
  147.     local($host, $port, $path) = @_;
  148.     local($margin) = $Indent . $margin;
  149.     local($stat);
  150.     local(@Items);
  151.  
  152.  
  153.     # Establish connection and read contents.
  154.     $DEBUG && print "DEBUG: connecting to $host at port $port.\n";
  155.     ($GOPHER) = &tcpconnect($host, $thishost);
  156.     ($GOPHER) || die "Can't connect";
  157.     $DEBUG && print "DEBUG: sending path \"$path\".\n";
  158.     send($GOPHER, "$path\r\n", 0);
  159.     @Items = <$GOPHER>;
  160.     close($GOPHER);
  161.  
  162.  
  163.     # Check each item, recursing into directories as necessary.
  164.     foreach (@Items) {
  165.         local($atype, $aname, $apath, $ahost, $aport, $aextra);
  166.  
  167.         chop; chop;        # remove \r\n combo
  168.         last if (/^\.$/);    # done if line is just a period
  169.  
  170.  
  171.         # Check status of each unique URL.
  172.         $url = &make_URL($_);
  173.         s/^(.)// && ($atype = $1);
  174.         ($aname, $apath, $ahost, $aport, $aextra) = split(/\t/, $_);
  175.         chop($ahost) if ($ahost =~ /\.$/);
  176.         if (defined($URLs{$url})) {    # already checked
  177.             print "$margin$aname...$URLs{$url}.\n";
  178.         }
  179.         else {
  180.             $stat = ($URLs{$url} = &test_URL($url, $aextra));
  181.             print "$margin$aname...$stat.\n";
  182.         }
  183.  
  184.  
  185.         # Recurse as necessary.
  186.         if ($stat eq "ok" && 
  187.                 $atype == 1 && 
  188.                 $ahost eq $inithost && 
  189.                 $aport eq $initport && 
  190.                 $apath ne "" &&
  191.                 $apath !~ /ftp.*:/) {
  192.             &check_Links($ahost, $aport, $apath);
  193.         }
  194.     }
  195. }
  196.  
  197.  
  198. ################################################
  199. #  make_URL - constructs a URL from a string.  #
  200. #                                              #
  201. #  Notes:                                      #
  202. #      - The URLs generated here are not 100%  #
  203. #        kosher, only used internally.         #
  204. #                                              #
  205. #  Entry:                                      #
  206. #        string as passed by gopher server.    #
  207. #  Exit:                                       #
  208. #        string representing URL.              #
  209. ################################################
  210. sub make_URL {
  211.     local($_) = @_;
  212.     local($url);
  213.     local($type, $name, $path, $host, $port);
  214.  
  215.  
  216.     s/^(.)// && ($type = $1);
  217.     ($name, $path, $host, $port) = split(/\t/, $_);
  218.     chop($host) if ($host =~ /\.$/);
  219.     if ($type =~ /[01245679sgMhIi]/) {
  220.         $url = "gopher://$host:$port/$type$path"
  221.     }
  222.     elsif ($type =~ /[8T]/) {
  223.         $url = "telnet://";
  224.         $path !~ /^$/ && $url .= "$path@";
  225.         $url .= $host;
  226.         $port > 0 && $url .= ":$port";
  227.         $url .= "/";
  228.     }
  229.     return($url);
  230. }
  231.  
  232.  
  233. ###########################################################################
  234. #  test_URL - check that a URL is accessible.                             #
  235. #                                                                         #
  236. #  Notes:                                                                 #
  237. #      - I don't have a good way to check gopher0 servers.  Currently, I  #
  238. #        look for the string "error.host", which servers like gn seem to  #
  239. #        generate.  However, this fails with KA9Q, for which an error     #
  240. #        message is indistinguishable from regular text.                  #
  241. #      - For gopher+, a error code indicating a server is too busy is     #
  242. #        treated as an error.  This may not be the right thing to do.     #
  243. #      - If the server understands gopher+, we'll only ask for info (!)   #
  244. #        so as not to retrieve large files.  This approach also seems to  #
  245. #        be the only way to check ASK blocks reliably.                    #
  246. #      - CSO nameservers (type 2) are checked with an invalid command -   #
  247. #        this returns a warning message from the server that is not       #
  248. #        regarded as an error by go4check.                                #
  249. #      - Checks of telnet links only see if host is up; no attempt        #
  250. #        is made to login to whatever account may be specified.           #
  251. #      - Checks of FTP links could be improved.  Currently, the info      #
  252. #        returned is not examined beyond looking for the usual signs      #
  253. #        of failure.                                                      #
  254. #  Entry:                                                                 #
  255. #        URL = URL to test                                                #
  256. #        GPLUS = extra character indicating a gopher+ item.               #
  257. #  Exit:                                                                  #
  258. #        Text string indicating status of URL:                            #
  259. #           "ok" = everything ok                                          #
  260. #           "can't connect" = can't connect to host                       #
  261. #           "path changed" = path changed                                 #
  262. #           "n/a" = unknown status                                        #
  263. ###########################################################################
  264. sub test_URL {
  265.     local($_, $gplus) = @_;
  266.     local($protocol, $logonid, $host, $port, $type, $path);
  267.     local($1, $2, $3, $4, $5);
  268.  
  269.  
  270.     $DEBUG && print "DEBUG: checking $_.\n";
  271.     m#^(\w+)://(.*):(\d+)/?(.?)(.*)#;
  272.     $protocol = $1;
  273.     $host = $2;
  274.     $port = $3;
  275.     $type = $4;
  276.     $path = $5;
  277.     if ($host =~ /@/) {
  278.         ($logonid, $host) = split(/@/, $host);
  279.     }
  280.     $DEBUG && print "protocol=$protocol; logonid=$logonid; host=$host; port=$port; type=$type; path=$path.\n";
  281.  
  282.  
  283.     # Check gopher links.
  284.     if ($protocol eq "gopher") {
  285.         local($GOPHER);
  286.         local($Stuff);
  287.  
  288.         $DEBUG && print "DEBUG: checking gopher at $host;$port.\n";
  289.         ($GOPHER) = &tcpconnect($host, $thishost);
  290.         ($GOPHER) || return "can't connect";
  291.         $path .= "\t!" if ($gplus);    # Modify selector to get only info
  292.         if ($type eq "2") {
  293.             $path = $default_path2 if ($path =~ /^$/);
  294.         }
  295.         elsif ($type eq "7") {
  296.             $path = $default_path7 if ($path =~ /^$/);
  297.             $path =~ s#^waissrc:(.*)/.*$#1$1#;
  298.         }
  299.         $DEBUG && print "DEBUG: sending path \"$path\".\n";
  300.         send($GOPHER, "$path\r\n", 0);
  301.         $Stuff = <$GOPHER>;
  302.         close($GOPHER);
  303.         $DEBUG && print "DEBUG: read \"$Stuff\".\n";
  304.  
  305.  
  306.         # Test line for signs of errors.
  307.         if ($Stuff =~ /(^\-\-\d)|(\terror.host\t\d+)/) {
  308.             return("path changed");
  309.         }
  310.         else {
  311.             return("ok");
  312.         }
  313.     }
  314.  
  315.  
  316.     # Check telnet links.
  317.     if ($protocol eq "telnet") {
  318.         local($TELNET);
  319.  
  320.         $DEBUG && print "DEBUG: checking telnet at $host;$port.\n";
  321.         ($TELNET) = &tcpconnect($host, $thishost);
  322.         ($TELNET) || return "host down";
  323.         return "ok";
  324.         close($TELNET);
  325.     }
  326.  
  327.  
  328.     # If we get here, we don't know how to test the link.    
  329.     return("n/a");
  330. }
  331.  
  332.  
  333. ################################################################
  334. #  This comes from gopherhunt by Paul Lindner.                 #
  335. #                                                              #
  336. #  I've added a line to abort if it can't resolve an address.  #
  337. #  and return 0 if failure rather than die. GAT                #
  338. ################################################################
  339. sub tcpconnect {                    #Get TCP info in place
  340.    local($host, $hostname) = @_;
  341.    local($name, $aliases, $type, $len);
  342.    local($thisaddr, $thataddr, $this, $that);
  343.    local($sockaddr);
  344.    $sockaddr = 'S n a4 x8';
  345.  
  346.    ($name,$aliases,$proto) = getprotobyname('tcp');
  347.    ($name,$aliases,$port) = getservbyname($port, 'tcp')
  348.         unless $port =~ /^\d+$/;
  349.    ($name,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname);
  350.    ($name,$aliases,$type,$len,$thataddr) = gethostbyname($host);
  351.    $name || return(0);
  352.  
  353.    $this = pack($sockaddr, &AF_INET, 0, $thisaddr);
  354.    $that = pack($sockaddr, &AF_INET, $port, $thataddr);
  355.  
  356.    sleep($snooze_length);
  357.  
  358.    socket(N, &PF_INET, &SOCK_STREAM, $proto) || return(0);
  359.    bind(N, $this)                            || return(0);
  360.    connect(N, $that)                         || return(0);
  361.  
  362.    return(N);
  363. }
  364.